perm filename ALFOUT.SAI[ALF,DEK] blob
sn#619057 filedate 1981-10-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 entry begin comment The Alphatype output submodule of METAFONT
C00004 00003 Cleaning up the picture
C00011 00004 The following procedure converts a bit pattern to its boundary,
C00021 00005 Conversion to Alphatype format
C00030 ENDMK
C⊗;
entry; begin comment The Alphatype output submodule of METAFONT;
require "MFHDR.SAI[mf,dek]" source_file;
comment This program makes the new (April 1981) style of ANT files
described in ANT.INF[alf,dek];
ifc SPECRAST thenc
require "
Note: rename ALFBIG.REL←ALFOUT.REL before loading MFSYS!" message;
elsec
require "
Note: rename ALFNRM.REL←ALFOUT.REL before loading MFSYS!" message;
endc
comment Caveat: Due to limitations of the CRS hardware, some bit patterns
will not be properly converted. The difficulty arises when two parts of
a character boundary nearly touch each other and have a horizontally-extreme
column in common, e.g.,
*********
*********
*********
*********
*********
*********
*********
*********
*********
*********
*********
*********
*********
*********
In such cases a vertical black stripe will appear above the offending
column. Sometimes this problem will arise only when characters are being
typeset smaller than at their encoded size, but sometimes it will happen
for METAFONT output being printed at its true size;
comment Cleaning up the picture;
saf integer array zz[0:6] # temporary storage;
internal procedure clean # removes anomalies from the raster image;
begin comment The effect of this procedure is (a) to expand the raster
image so that every white pixel is part of a 7x7 square of white pixels, then
(b) to contract the result of (a) so that every black pixel is part of a 7x7
square of black pixels. The method is discussed in the CS204 class notes
from autumn 1978.
Rows alfylow thru alfyhigh and columns alfxleft thru alfxright are treated.
The calling procedure has set things up so that the rightmost 6 bits are zero
in each word of column alfxright;
integer y,z,xw,x,xwh,k,u;
label phase1,phase2,phase3,phase4,phase5;
comment Phase 1 replaces x[i,j] by x[i,j] ∨ ... ∨ x[i-6,j];
phase1:
for y←alfylow thru alfyhigh do
begin z←0;
for xw←alfxleft*rspan+y step rspan until alfxright*rspan+y do
begin integer t,tt; var!gets!rast(t,xw);
tt←t lor (t lsh -1);
tt←tt lor (tt lsh -2);
rast!gets!expr(xw,tt lor (tt lsh -3) lor (-(z land -z)));
z←t lsh (bitsperwd-6);
end;
end;
comment Phase 2 replaces x[i,j] by z[i,j] ∧ ... ∧ z[i,j+6], where
z[i,j] = x[i,j] ∨ ... ∨ x[i,j-6];
phase2:
for x←alfxleft thru alfxright do
begin xw←x*rspan+alfylow;
IFXMEM xbltit(location(zz[0]),rast!loc(xw),7);
zz[1]←zz[0] lor zz[1]; zz[2]←zz[1] lor zz[2];
zz[3]←zz[2] lor zz[3]; zz[4]←zz[3] lor zz[4];
zz[5]←zz[4] lor zz[5]; zz[6]←zz[5] lor zz[6];
ELSEC zz[1]←rast[xw] lor rast[xw+1]; zz[2]←zz[1] lor rast[xw+2];
zz[3]←zz[2] lor rast[xw+3]; zz[4]←zz[3] lor rast[xw+4];
zz[5]←zz[4] lor rast[xw+5]; zz[6]←zz[5] lor rast[xw+6];
ENDC
k←6; xwh←xw-alfylow+alfyhigh-1; while xw<xwh do
begin xw←xw+1; k←k+1; if k>6 then k←0;
if xw+5≤xwh then var!gets!seven!rast!lors(zz[k],xw)
else begin integer xwi,acc; var!gets!rast(acc,xw); xwi←xw;
while xwi≤xwh do
begin xwi←xwi+1; var!gets!rast!lor!var(acc,xwi);
end;
zz[k]←acc;
end;
rast!gets!expr(xw,zz[0] land zz[1] land zz[2] land zz[3] land
zz[4] land zz[5] land zz[6]);
end;
end;
comment Phase 3 replaces x[i,j] by x[i-6,j] ∧ ... ∧ x[i+6,j];
phase3:
for y←alfylow thru alfyhigh do
begin xw←alfxleft*rspan+y; xwh←alfxright*rspan+y; z←0; var!gets!rast(u,xw);
while xw≤xwh do
begin integer w,u1,u2,t,tt;
comment Now $z$ and $u$ hold the former values of $\\{rast}[\\{xw}
-\\{rspan}]$ and $\\{rast}[\\{xw}]$;
if xw<xwh then var!gets!rast(w,xw+rspan) else w←0;
u1←(z lsh (bitsperwd-6)) lor (u lsh -6);
u2←(w lsh (6-bitsperwd)) lor (u lsh +6);
comment The following code works if $\\{bitsperwd}≥24$;
t←u1 land (u1 lsh -1);
t←t land (t lsh -2);
t←t land (t lsh -4);
t←t land (t lsh -5);
tt←u2 land (u2 lsh 1);
tt←tt land (tt lsh 2);
tt←tt land (tt lsh 4);
tt←tt land (tt lsh 5);
rast!gets!expr(xw,(t lsh 12) lor (tt lsh -12));
xw←xw+rspan; z←u; u←w;
end;
end;
comment Phase 4 replaces x[i,j] by z[i,j] ∨ ... ∨ z[i,j+6], where
z[i,j] = x[i,j] ∧ ... ∧ x[i,j-6];
phase4:
for x←alfxleft thru alfxright do
begin xw←x*rspan+alfylow;
zz[0]←zz[1]←zz[2]←zz[3]←zz[4]←zz[5]←0;
k←6; xwh←xw-alfylow+alfyhigh; while xw≤xwh do
begin
if xw+6≤xwh then var!gets!seven!rast!lands(zz[k],xw)
else zz[k]←0;
rast!gets!expr(xw,zz[0] lor zz[1] lor zz[2] lor zz[3] lor
zz[4] lor zz[5] lor zz[6]);
xw←xw+1; k←k+1; if k>6 then k←0;
end;
end;
comment Phase 5 replaces x[i,j] by x[i,j] ∨ ... ∨ x[i+6,j];
phase5:
for y←alfylow thru alfyhigh do
begin z←0;
for xw←alfxright*rspan+y step -rspan until alfxleft*rspan+y do
begin integer r,t,tt; var!gets!rast(r,xw);
t←r land (all_ones lsh (bitsperwd-6));
tt←((r land (all_ones lsh -6)) lor z) rot 6;
tt←tt lor (tt lsh -1);
tt←tt lor (tt lsh -2);
rast!gets!expr(xw,tt lor (tt lsh -3) lor (-(t land -t)));
z←t;
end;
end;
end;
comment The following procedure converts a bit pattern to its boundary,
in the rectangle specified by alfxleft, alfxright, alfylow, and alfyhigh, assuming that
the bit pattern does not have the consecutive bits "0 1 0" in any row or column.
The boundary is stored in linked form in the \\{blink} array, where each
entry has three fields \\{dir}, \\{ll}, \\{rr}. The \\{ll} and \\{rr} fields
are pointers to the next boundary edge of a cycle, and \\{dir} specifies the
orientation of the vertices at these connecting links:
dir=0 means \\{ll} is one step west of \\{rr},
dir=1 means \\{ll} is one step south of \\{rr},
dir=2 means \\{ll} is one step southwest of \\{rr},
dir=3 means \\{ll} is one step southeast of \\{rr}.
No explicit coordinates of points are given in such linked entries. However,
before every word whose \\{ll} and \\{rr} fields both point to subsequent nodes,
an additional word in the \\{blink} array specifies $x$ and $y$ coordinates of
the \\{ll} part of the following word. For example, the boundaries of
******
******
** **
** **
******
******
where the lower left corner point has coordinates (0,0) and the upper right corner
point has coordinates (5,5) would be represented thus:
entry dir ll rr entry dir ll rr
01 (4, 5) 16 1 20 11
02 0 03 07 17 1 22 13
03 0 04 02 18 1 23 14
04 0 05 03 19 1 24 15
05 0 06 04 20 2 21 16
06 0 08 05 21 0 22 20
07 1 09 02 22 3 21 17
08 1 14 06 23 1 25 18
09 1 15 07 24 1 26 19
10 (4, 3) 25 1 30 23
11 3 16 12 26 0 27 24
12 0 13 11 27 0 28 26
13 2 17 12 28 0 29 27
14 1 18 08 29 0 30 28
15 1 19 09 30 0 25 29
Boundary edges are recognized by 2x2 squares
ab
dc
as follows:
abcd=1100 means edge ab
abcd=0110 means edge bc
abcd=0011 means edge cd
abcd=1001 means edge ad
abcd=1011 or 1110 means edge ac
abcd=0111 or 1101 means edge bd.
It can be proved that these edges touch every vertex 0 or 2 times. The edges are
entered in the \\{blink} table from top to bottom, right to left. In the above
example the edges corresponding to entries 02, 03, ..., 30 can be depicted thus:
*06*05*04*03*02*
08 07
* * *12* * *
14 13 11 09
* * * *
18 17 16 15
* * * *
23 22 20 19
* * *21* * *
25 24
*30*29*28*27*26*
;
define rrd=0,rrs=15,lld=15,lls=15,dird=30,dirs=bitsperwd-dird # fields;
define stlink(aa,bb)=⊂if type(aa) then setfield(rr,blink[vmemint(aa)],bb)
else setfield(ll,blink[vmemint(aa)],bb)⊃;
integer bptr # number of entries in \\{blink};
define blinkmax=1006*12;
saf integer array blink[1:blinkmax+1];
internal procedure boundarize;
begin integer y,x,xw,xw0,za,zb,zc,zd,t,tt,zz,prevb;
integer a # pointer to list of "open" vertices on row $y+1$;
integer b # pointer to list of "open" vertices on row $y$;
y←alfyhigh; a←0; bptr←0; mem[0]←0;
while y≥alfylow-1 do
begin mem[temphead]←0; b←temphead;
xw←alfxright*rspan+y; xw0←(alfxleft-1)*rspan+y; x←(alfxright+1)*bitsperwd;
za←zd←0;
while xw≥xw0 do
begin integer z5,z6,w # edges of various types;
zb←za lsh (1-bitsperwd);
if y<alfyhigh and xw>xw0 then var!gets!rast(za,xw+1) else za←0;
zb←(za lsh 1)+zb;
zc←zd lsh (1-bitsperwd);
if y≥alfylow and xw>xw0 then var!gets!rast(zd,xw) else zd←0;
zc←(zd lsh 1)+zc;
t←za xor zc; tt←zb xor zd;
z5←tt land za land zc;
z6←t land zb land zd;
w←t land tt;
zz←w lor z5 lor z6 # z1 ∨ ... ∨ z6;
while zz do
begin integer xx,zzz,xxx,d,aa;
label case1,case2,case3,case4,case5,case6,upcase,
newb,insbd,insd;
zzz←zz land -zz # least 1; zz←zz xor zzz;
xx←x-bit_id[(zzz lsh -1) mod 37] # relative $x$ coordinate;
comment Here we are assuming that $\\{bitsperwd}≤36$;
xxx←xx # $x$ coordinate in row $y+1$;
bptr←bptr+1;
if bptr>blinkmax then return # too much boundary;
if zzz land w then
if zzz land za then
if zzz land zb then go to case1
else go to case4
else if zzz land zb then go to case2
else go to case3
else if zzz land z5 then go to case5 else go to case6;
case1: comment Now $\\{name}(a)=\\{xx}+1$;
d←0;
stlink(a,bptr); blink[bptr]←vmemint(a);
aa←link(a); if name(aa)=xx then
begin stlink(aa,bptr);
blink[bptr]←blink[bptr]+(vmemint(aa) lsh lld);
freeavail(a); a←link(aa); freeavail(aa); go to insd;
end
else begin mem[a]←(mem[a] land ((1 lsh typed)-1))
-(1 lsh named);
vmemint(a)←bptr; go to insd;
end;
case2: d←1 lsh typed; xx←xx+1; xxx←xxx+1; go to upcase;
case5: d←3 lsh typed; xx←xx+1; go to upcase;
case6: d←2 lsh typed; xxx←xxx+1; go to upcase;
case4: d←1 lsh typed;
upcase: if name(a)=xxx then
begin stlink(a,bptr); blink[bptr]←vmemint(a);
if name(b)=xx then
begin stlink(b,bptr);
blink[bptr]←blink[bptr]+(vmemint(b)lsh lld);
aa←link(a); freeavail(a); a←aa;
freeavail(b); b←prevb; go to insd;
end
else begin setlink(b,a); prevb←b; b←a; a←link(a);
go to insbd;
end;
end
else if name(b)=xx then
begin stlink(b,bptr); blink[bptr]←vmemint(b)lsh lld;
aa←b; b←prevb; vmemint(aa)←bptr;
mem[aa]←(xxx lsh named)+a+(1 lsh typed); a←aa;
go to insd;
end
else begin getvavail(aa);
blink[bptr]←(xx lsh lld)+y-(yrastmin+ypenmin-1);
bptr←bptr+1; vmemint(aa)←bptr;
mem[aa]←(xxx lsh named)+a+(1 lsh typed); a←aa;
go to newb;
end;
case3: d←0; if name(b)=xx+1 then
begin stlink(b,bptr); blink[bptr]←vmemint(b);
mem[b]←mem[b]-(1 lsh named); vmemint(b)←bptr;
go to insd;
end
else begin getvavail(aa); setlink(b,aa); b←aa;
blink[bptr]←(xx lsh lld)+y-(yrastmin+ypenmin-1);
bptr←bptr+1; vmemint(b)←bptr;
mem[b]←((xx+1) lsh named)+(1 lsh typed);
go to newb;
end;
newb: getvavail(aa); setlink(b,aa); prevb←b; b←aa;
insbd: vmemint(b)←bptr; mem[b]←xx lsh named;
insd: blink[bptr]←blink[bptr]+d;
end;
xw←xw-rspan; x←x-bitsperwd;
end;
y←y-1; setlink(b,0); a←link(temphead);
end;
end;
comment Conversion to Alphatype format;
saf integer array byte[1:1008] # encoded boundary data;
preload_with 6, 7, 8, 9,10,11,12,
5, 0, 0, 0, 0, 0,13,
4, 0, 0, 0, 0, 0,14,
3, 0, 0, 0, 0, 0,15,
2, 0, 0, 0, 0, 0,16,
1, 0, 0, 0, 0, 0,17,
0,23,22,21,20,19,18; saf integer array dircode[7*(-3)-3:7*3+3];
preload_with -1,0,-1,+1; saf integer array dxt[0:3];
preload_with 0,-1,-1,-1; saf integer array dyt[0:3];
preload_with '30,'20,'10,1,2,3,4,5,6,7,'70,'60,'50;
saf integer array movecode[-6:+6];
preload_with 0,-1,-2,0,-1,-2,0,2,1,0,2,1,0; saf integer array correction[-6:+6];
internal integer procedure crscode;
begin comment returns -1 if the character is too big, 0 if it is empty,
otherwise the number of bytes of boundary data;
integer i # number of \\{blink} entries examined for cycle leaders;
integer ii # number of output bytes;
integer qq # extra byte times;
integer minx,maxx # extremes of $x$ coordinates;
integer xc # current $x$ coordinate;
integer d # current direction code (0 = SE, 3 = S, 6 = SW, ..., 21 = E);
integer p,q,r # pointers that traverse the boundary;
integer acc # three-bit codes or code fragments not yet output;
integer b # number of bits in \\{acc};
integer bytetimes # total number of byte times in the character;
if bptr>blinkmax then return(-1);
i←ii←0; qq←7; minx←10000; maxx←-10000;
loop begin integer x0,y0 # starting coordinates of a cycle;
boolean ended # the cycle has ended;
i←i+1; if i>bptr then done;
if blink[i]=0 then continue;
i←i+1; if blink[i]=0 then continue;
xc←x0←field(ll,blink[i-1])+(360-rcol(0)*bitsperwd-hw)-xoffset;
y0←field(rr,blink[i-1])+(369-1+yrastmin+ypenmin)-yoffset;
comment Point (0,0) actually has coordinates
(rcol(0)*bitsperwd+hw,1-(yrastmin+ypenmin)) in blink;
if field(dir,blink[i])=0 then
begin p←i+1; q←i;
end
else begin p←i+2; q←i+1; x0←x0-2; y0←y0+1 # cycle begins on case5 edge;
end;
comment Now $p$ is the \\{ll} point of edge $q$, which has direction 0;
if ii>1006-7 then return(-1);
byte[ii+1]←0; byte[ii+2]←x0 land '377; byte[ii+3]←'140+(x0 lsh -8);
byte[ii+4]←y0 land '377; byte[ii+5]←y0 lsh -8;
if ii>0 then ii←ii+5
else begin byte[3]←byte[3] lor '30 # "zz=11" on first cycle;
for ii←6 thru 13 do byte[ii]←'377;
ii←13;
end;
comment Now traverse the boundary;
d←9 # initial direction is west;
blink[q]←0;
acc←b←0;
ended←false;
loop begin comment this loop is performed once per change in direction;
integer n # number of boundary bits to go in current direction;
integer c # next direction change;
integer dx,dy # local change in $x$ and $y$ for next step;
integer dd # direction code;
n←0;
loop begin comment Get the next change of direction;
dx←dy←0;
loop begin r←field(ll,blink[p]);
if r=0 then
begin dx←-3 # end of cycle, go west;
ended←true; done;
end;
dd←field(dir,blink[p]);
if r=q then
begin r←field(rr,blink[p]);
dx←dx-dxt[dd]; dy←dy-dyt[dd];
end
else begin dx←dx+dxt[dd]; dy←dy+dyt[dd];
end;
blink[p]←0; q←p; p←r;
if abs(dx)=3 or abs(dy)=3 then done;
end;
xc←xc+dx;
if xc<minx then minx←xc; if xc>maxx then maxx←xc;
dd←dircode[7*dx+dy];
if dd=d and not ended then n←n+3
else begin c←dd-d;
if c<-6 then c←c+24 else if c>6 then c←c-24;
comment Now $-6≤c≤+6$ (or my theory is wrong);
d←dd+correction[c]; if d=24 then d←0;
done;
end;
end;
loop begin comment output the motion represented by $n$ and $c$;
if b<8 then
begin if n>0 then
if n≥30 then
begin n←n-30; qq←qq+21;
acc←acc lor('740 lsh b); b←b+9;
end
else if n≥12 then
begin integer k; k←(n-9) div 3;
n←0; qq←qq+3*k;
acc←acc lor ('40 lsh b) lor
(k lsh (b+6)); b←b+9;
end
else begin n←n-3;
acc←acc lor (4 lsh b); b←b+3;
end
else begin acc←acc lor (movecode[c] lsh b);
if abs(c)>3 then b←b+6 else b←b+3;
done;
end;
end
else begin ii←ii+1; if ii>1006 then return(-1);
byte[ii]←acc land '377; acc←acc lsh -8; b←b-8;
end;
end;
if ended then done;
end;
while byte[ii]≠0 do
begin ii←ii+1; if ii>1006 then return(-1);
byte[ii]←acc land '377; acc←acc lsh -8;
end;
end;
if ii=0 then return(0);
bytetimes←ii+(qq lsh -3);
if bytetimes>1006 then return(-1);
if maxht=696969 then
begin print(nextline,nextline,"Data for character '",cvos(charcode));
print(nextline,"fntptr='",cvos(fntptr));
print(nextline,"yoffset='",cvos(yoffset)," (",(3*yoffset)div 10," fu)");
print(nextline,"xoffset='",cvos(xoffset)," (",(2*xoffset)div 3," du)");
print(nextline,"minx='",cvos(minx));
print(nextline,"maxx='",cvos(maxx));
print(nextline,"bytetimes='",cvos(bytetimes));
print(nextline,"alfptr='",cvos(alfptr));
print(nextline,"There are ",ii," boundary bytes, namely:");
begin integer i;
i←0;
while i<ii do
begin if i land 7 = 0 then print(nextline);
i←i+1;
print("'",cvos(byte[i]),",");
end;
end;
end;
comment Now the data is output to the font file;
begin integer x # random number;
integer i # number of bytes output;
x←antid;
alfptr←alfptr+((ii+3) div 4);
i←0;
while i<ii do
begin integer x1,x2;
x←367965721*x+256854611; x1←(x lsh -16) land '177777;
x←367965721*x+256854611; x2←x land ('177777 lsh 16);
antid←x1 xor x2 xor ((((((byte[i+1] lsh 8) +
byte[i+2]) lsh 8) + byte[i+3]) lsh 8) + byte[i+4]);
wordout(alfch,antid lsh (bitsperwd-32));
i←i+4;
end;
end;
minmax[fntptr]←(((minx lsh 11)+maxx) lsh 10)+bytetimes;
return(ii);
end;
end